home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
prog
/
regist.zip
/
REGCONP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-05-08
|
22KB
|
730 lines
Procedure Regconp;
{$I-}
CONST REGISTERName = 'REGISTER';
Const REGISTERMSGLN = 25;
REGISTERMsgPos = 1;
REGISTERFldln : Array[1..34] OF Integer =
(1,1,2,2,3,4,4,5,6,6,7,7,8,8,9,10,11,11,11,12,13,13,13,13,14
,15,16,17,18,19,20,21,22,23);
REGISTERFldpos : Array[1..34] OF Integer =
(1,69,10,21,3,21,59,59,21,59,3,59,3,59,3,3,12,46,58,12,12,37,46,65,3
,3,3,3,3,3,3,3,3,3);
REGISTERFldlen : Array[1..34] OF Integer =
(10,11,2,57,75,10,20,20,21,20,39,20,39,20,39,76,25,11,21,25,20,2,11,14,75
,75,75,75,75,75,75,75,75,75);
REGISTERFldtyp : Array[1..34] OF Char =
('X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X'
,'X','X','X','X','X','X','X','X','X');
REGISTERFldInts : Array[1..34] OF Char =
(' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '
,' ',' ',' ',' ',' ',' ',' ',' ',' ');
REGISTERFlddecN : Array[1..34] OF BYTE =
(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
,0,0,0,0,0,0,0,0,0);
REGISTERFldcolr : Array[1..34] OF Char =
('Y','Y','G','W','W','R','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W'
,'W','W','W','W','W','W','W','W','W');
REGISTERFldattr : Array[1..34] OF Char =
('P','P',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '
,' ',' ',' ',' ',' ',' ',' ',' ','P');
REGISTERFldKey : Array[1..34] OF Char =
(' ',' ','K','K',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '
,' ',' ',' ',' ',' ',' ',' ',' ',' ');
{$I REGISTER.TYP}
REGISTERArray = Array[1..2792] OF Char;
Spaces = String[100];
Var
REGISTERSpaces : Spaces;
REGISTERCodestr : Codestr;
REGISTERMaxrec : Integer;
Scrnptr : ScreenPointer;
REGISTERTxfile : Text;
REGISTERLdfile : File;
REGISTERDbfile : DataFile;
REGISTERI3 : IndexFile;
REGISTERI4 : IndexFile;
REGISTERFilename : String;
REGISTERDbrec : REGISTERData;
REGISTERDbstr : Array[1..2792] OF Char ABSOLUTE REGISTERDbrec;
REGISTERTmDbrec : REGISTERTmData;
REGISTERTmDbstr : Array[1..2792] OF Char ABSOLUTE REGISTERTmDbrec;
REGISTERMsgStr : String[79];
Procedure GetDateTime;
Begin
GetTime(Hour, Minute, Second, Sec100);
Str(Hour:2, Tchr);
Str(Minute:2, Tchr1);
Tchr := Tchr + ':' + tchr1;
Str(Second:2,Tchr1);
Tchr := Tchr + ':' + tchr1;
Str(Sec100:2, Tchr1);
Tchr := Tchr + ':' + Tchr1;
ScreenTime := Tchr;
GetDate(Year, Month, Day, DayofWeek);
Str(Year:2, Tchr);
Str(Month:2, Tchr1);
If Tchr[1] = ' ' Then Tchr[1] := '0';
Tchr := Tchr + '/' + Tchr1;
Str(Day, Tchr1);
If Tchr1[1] = ' ' Then Tchr[1] := '0';
Tchr := Tchr + '/' + Tchr1;
ScreenDate := Tchr;
End;
Procedure REGISTER_Init;
Begin
HldFldseq := 1;
Frstdatafld := 1;
Lastdatafld := 34;
Continue := True;
Datalen := 0;
For Fldseq := 1 TO Lastdatafld DO
Begin
Datalen := Datalen + REGISTERFldlen[Fldseq] + 1;
Mapln[Fldseq] := REGISTERFldln[Fldseq];
Mappos[Fldseq] := REGISTERFldpos[Fldseq];
Maplen[Fldseq] := REGISTERFldlen[Fldseq];
Maptyp[Fldseq] := REGISTERFldtyp[Fldseq];
Mapdecn[Fldseq] := REGISTERFlddecN[Fldseq];
Mapints[Fldseq] := REGISTERFLDINTS[Fldseq];
Mapcolr[Fldseq] := REGISTERFldcolr[Fldseq];
Mapattr[Fldseq] := REGISTERFldattr[Fldseq];
MapKey[Fldseq] := REGISTERFldKey[Fldseq];
End;
Datalen := Datalen + 4;
For Posndx := 1 TO Datalen DO
Begin
REGISTERDbstr[Posndx] := ' ';
End;
For Ypos := 1 TO 25 DO
Begin
For Xpos := 1 TO 80 DO
Begin
Scrnln[Ypos, Xpos] := ' ';
End;
End;
TextBackGround(Black);
TextColor(Blue);
If ClearScrn Then ClrScr;
For Xpos := 1 To 79 Do ScrnLn[1, Xpos] := ' ';
REGISTERMsgStr :=
' REGISTER FORM ';
Lnndx := 1;
For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
Gotoxy(1,1);
Write(
' REGISTER FORM ');
REGISTERMsgStr :=
' ENTRY: TITLE: ';
Lnndx := 2;
For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
Gotoxy(1,2);
Write(
' ENTRY: TITLE: ');
REGISTERMsgStr :=
' REGISTRATION FEE: REGISTER TO: ';
Lnndx := 4;
For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
Gotoxy(1,4);
Write(
' REGISTRATION FEE: REGISTER TO: ');
REGISTERMsgStr :=
' DESCRIPTION: ';
Lnndx := 6;
For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
Gotoxy(1,6);
Write(
' DESCRIPTION: ');
REGISTERMsgStr :=
' NAME: SSN: ';
Lnndx := 11;
For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
Gotoxy(1,11);
Write(
' NAME: SSN: ');
REGISTERMsgStr :=
' ADDRESS: ';
Lnndx := 12;
For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
Gotoxy(1,12);
Write(
' ADDRESS: ');
REGISTERMsgStr :=
' CITY: ST: ZIP: PHONE: ';
Lnndx := 13;
For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
Gotoxy(1,13);
Write(
' CITY: ST: ZIP: PHONE: ');
TextColor(Blue);
REGISTERMsgStr :=
' Ent-Get F2-Next F3-Prev F4-Find F5-List F6-Add F7-Updt F8-Del F10-Util ';
Lnndx := 24;
For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
Gotoxy(1,24);
Write(
' Ent-Get F2-Next F3-Prev F4-Find F5-List F6-Add F7-Updt F8-Del F10-Util ');
X1 := 1; X2 := 79; Y1 := 1; Y2 := 25;
TextColor(Red);
GotoXY(X1, Y1);
Write(UpLeft);
for x := succ(X1) to pred(X2) do
Write(HWall);
GotoXY(X2, Y1);
Write(UpRight);
for Y := succ(Y1) to pred(Y2) do
begin
GotoXY(X2, y);
Write(VWall);
end;
GotoXY(X1, Y2);
Write(LoLeft);
for x := succ(X1) to pred(X2) do
Write(HWall);
Write(LoRight);
for Y := pred(Y2) downto succ(Y1) do
begin
GotoXY(X1, y);
Write(VWall);
end;
GotoXY(1,1);
X2 := 79; X1 := 1;
While (Scrnln[1,X2] = ' ') and (X2 > 1) Do
X2 := X2 - 1;
While (Scrnln[1,X1] = ' ') and (X1 < 80) Do
X1 := X1 + 1;
For Xpos := X1 To X2 Do
Begin
GoTOXY(Xpos,1);
Write(Scrnln[1,Xpos]);
End;
End;
Procedure REGISTER_FmtRecBuf;
Begin
Posndx := 5;
For Fldseq := 1 TO Lastdatafld Do
Begin
Posndx := Posndx + 1;
Xpos := REGISTERFldpos[Fldseq];
Ypos := REGISTERFldln[Fldseq];
For Xpos := Xpos TO Xpos + REGISTERFldlen[Fldseq] - 1 DO
Begin
REGISTERDbstr[Posndx] := Scrnln[Ypos,Xpos];
Posndx := Posndx + 1;
End;
End;
End;
Procedure REGISTER_FmtScrnBuf;
Begin
REGISTERTmDbrec.datafld1 := REGISTERDbrec.Datafld1;
REGISTERTmDbrec.datafld2 := REGISTERDbrec.Datafld2;
REGISTERTmDbrec.datafld3 := REGISTERDbrec.Datafld3;
REGISTERTmDbrec.datafld4 := REGISTERDbrec.Datafld4;
REGISTERTmDbrec.datafld5 := REGISTERDbrec.Datafld5;
REGISTERTmDbrec.datafld6 := REGISTERDbrec.Datafld6;
REGISTERTmDbrec.datafld7 := REGISTERDbrec.Datafld7;
REGISTERTmDbrec.datafld8 := REGISTERDbrec.Datafld8;
REGISTERTmDbrec.datafld9 := REGISTERDbrec.Datafld9;
REGISTERTmDbrec.datafld10 := REGISTERDbrec.Datafld10;
REGISTERTmDbrec.datafld11 := REGISTERDbrec.Datafld11;
REGISTERTmDbrec.datafld12 := REGISTERDbrec.Datafld12;
REGISTERTmDbrec.datafld13 := REGISTERDbrec.Datafld13;
REGISTERTmDbrec.datafld14 := REGISTERDbrec.Datafld14;
REGISTERTmDbrec.datafld15 := REGISTERDbrec.Datafld15;
REGISTERTmDbrec.datafld16 := REGISTERDbrec.Datafld16;
REGISTERTmDbrec.datafld17 := REGISTERDbrec.Datafld17;
REGISTERTmDbrec.datafld18 := REGISTERDbrec.Datafld18;
REGISTERTmDbrec.datafld19 := REGISTERDbrec.Datafld19;
REGISTERTmDbrec.datafld20 := REGISTERDbrec.Datafld20;
REGISTERTmDbrec.datafld21 := REGISTERDbrec.Datafld21;
REGISTERTmDbrec.datafld22 := REGISTERDbrec.Datafld22;
REGISTERTmDbrec.datafld23 := REGISTERDbrec.Datafld23;
REGISTERTmDbrec.datafld24 := REGISTERDbrec.Datafld24;
REGISTERTmDbrec.datafld25 := REGISTERDbrec.Datafld25;
REGISTERTmDbrec.datafld26 := REGISTERDbrec.Datafld26;
REGISTERTmDbrec.datafld27 := REGISTERDbrec.Datafld27;
REGISTERTmDbrec.datafld28 := REGISTERDbrec.Datafld28;
REGISTERTmDbrec.datafld29 := REGISTERDbrec.Datafld29;
REGISTERTmDbrec.datafld30 := REGISTERDbrec.Datafld30;
REGISTERTmDbrec.datafld31 := REGISTERDbrec.Datafld31;
REGISTERTmDbrec.datafld32 := REGISTERDbrec.Datafld32;
REGISTERTmDbrec.datafld33 := REGISTERDbrec.Datafld33;
REGISTERTmDbrec.datafld34 := REGISTERDbrec.Datafld34;
Posndx := 5;
For Fldseq := 1 TO Lastdatafld DO
Begin
Posndx := Posndx + 1;
Xpos := REGISTERFldpos[Fldseq];
Ypos := REGISTERFldln[Fldseq];
Case MapColr[Fldseq] Of
'R' : TextColor(Red);
'G' : TextColor(Green);
'B' : TextColor(Blue);
'Y' : TextColor(Yellow);
'W' : TextColor(White);
'C' : TextColor(Cyan);
Else TextColor(White);
End;
For Xpos := Xpos TO Xpos + REGISTERFldlen[Fldseq] - 1 DO
Begin
Scrnln[Ypos, XPos] := REGISTERDbStr[Posndx];
GotoXY(Xpos,Ypos);
Write(REGISTERDbstr[Posndx]);
REGISTERTmDbstr[Posndx] := REGISTERDbstr[Posndx];
Posndx := Posndx + 1
End;
End;
End;
Procedure FlushRecord;
Begin
FlushFile(REGISTERDbFile);
FlushIndex(REGISTERI3);
FlushIndex(REGISTERI4);
End;
Procedure Select_Rcd;
Begin
IF OK Then
Begin
GETREC(REGISTERDbfile,RecordNumber,REGISTERDbrec);
REGISTERMsgStr := 'Record Found';
End
Else
REGISTERMsgStr := 'Record Not Found';
End;
Procedure Next_Rcd;
Begin
If OK Then
Begin
GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
REGISTERMsgStr := 'Next Record Found';
End
Else
REGISTERMsgStr := 'The End of the Database Has Been Reached';
End;
Procedure Prev_Rcd;
Begin
If OK Then
Begin
GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
REGISTERMsgStr := 'Prev Record Found';
End
Else
REGISTERMsgStr := 'The Begining of the Database Has Been reached';
End;
Procedure Find_Rcd;
Begin
If OK Then
Begin
GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
REGISTERMsgStr := 'Search Record Found';
End
Else
REGISTERMsgStr := 'Search Record Not Found';
End;
Procedure List_Rcd;
Begin
For Ypos := 1 To 25 Do
Begin
For Xpos := 1 To 79 Do
Begin
Tchr[Xpos] := Scrnln[Ypos,Xpos];
End;
Tchr[0] := #79;
Writeln(LST,Tchr);
If IoResult <> 0 Then
Begin
RegisterMsgStr :=
'Printer Error - Depress Enter to Try Again or Depress ESC To Exit';
Exit;
End;
End;
If IoResult <> 0 Then
Begin
RegisterMsgStr :=
'Printer Error - Depress Enter to Try Again or Depress ESC To Exit';
Gotoxy(2,REGISTERMsgln);
Write(REGISTERMsgStr);
Keychar := Readkey;
Exit;
End;
Writeln(LST);
Keychar := ' ';
Function_Key := ' ';
Function_ID := ' ';
Tchr1 := 'R';
Global_Register_Val := 'Y';
End;
Procedure Insert_Rcd;
Begin
Addrec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
REGISTERCodeStr := REGISTERDbRec.Datafld3;
Addkey(REGISTERI3,RecordNumber,REGISTERDbrec.Datafld3);
Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
REGISTERCodeStr := REGISTERDbRec.Datafld4;
Addkey(REGISTERI4,RecordNumber,REGISTERDbrec.Datafld4);
REGISTERMsgStr := 'Record Has Been Added';
FlushRecord;
End;
Procedure Update_Rcd;
Begin
If OK Then
Begin
GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
REGISTER_FmtRecBuf;
Putrec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
If REGISTERTmDbRec.Datafld3 <> REGISTERDbrec.DataFld3 Then
Begin
Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
REGISTERCodeStr := REGISTERTmDbRec.Datafld3;
DeleteKey(REGISTERI3,RecordNumber,REGISTERTmDbrec.datafld3);
Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
REGISTERCodeStr := REGISTERDbRec.Datafld3;
AddKey(REGISTERI3,RecordNumber,REGISTERDbrec.datafld3);
End;
If REGISTERTmDbRec.Datafld4 <> REGISTERDbrec.DataFld4 Then
Begin
Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
REGISTERCodeStr := REGISTERTmDbRec.Datafld4;
DeleteKey(REGISTERI4,RecordNumber,REGISTERTmDbrec.datafld4);
Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
REGISTERCodeStr := REGISTERDbRec.Datafld4;
AddKey(REGISTERI4,RecordNumber,REGISTERDbrec.datafld4);
End;
REGISTERMsgStr := 'Record Has Been Updated';
End
Else
REGISTERMsgStr := 'Update Record Not Found';
FlushRecord;
End;
Procedure Delete_Rcd;
Begin
If OK Then
Begin
Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
REGISTERCodeStr :=REGISTERDbrec.Datafld3;
DeleteKey(REGISTERI3,RecordNumber,REGISTERDbrec.Datafld3);
Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
REGISTERCodeStr :=REGISTERDbrec.Datafld4;
DeleteKey(REGISTERI4,RecordNumber,REGISTERDbrec.Datafld4);
DeleteRec(REGISTERDbfile,RecordNumber);
REGISTERMsgStr := 'Record Has Been Deleted';
For Xpos := 1 to Datalen Do
Begin
REGISTERDbStr[Xpos] := ' ';
End;
End
Else
REGISTERMsgStr := 'Delete Record Not Found';
FlushRecord;
End;
Procedure Rebuild_Index;
Begin
Dups := False;
Case Fldseq Of
3 : Begin
Size := Sizeof(REGISTERDbRec.Datafld3) - 1;
REGISTERFilename := 'REGISTER.I3';
MakeIndex(REGISTERI3,REGISTERFilename,Size,Duplicates);
For RecordNumber := 1 To Filelen(REGISTERDbfile) - 1 Do
Begin
GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
REGISTERCodeStr := REGISTERDbrec.Datafld3;
AddKey(REGISTERI3,RecordNumber,REGISTERDbRec.Datafld3);
End;
End;
4 : Begin
Size := Sizeof(REGISTERDbRec.Datafld4) - 1;
REGISTERFilename := 'REGISTER.I4';
MakeIndex(REGISTERI4,REGISTERFilename,Size,Duplicates);
For RecordNumber := 1 To Filelen(REGISTERDbfile) - 1 Do
Begin
GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
REGISTERCodeStr := REGISTERDbrec.Datafld4;
AddKey(REGISTERI4,RecordNumber,REGISTERDbRec.Datafld4);
End;
End;
Else REGISTERMsgStr := 'Cursor not on Index Field';
End;
FlushRecord;
End;
Procedure Open_DataBase;
Begin
REGISTERFilename := 'REGISTER.DAT';
Size := Sizeof(REGISTERDbrec);
Openfile(REGISTERDbfile,REGISTERFilename,Size);
If Not OK Then
Begin
Makefile(REGISTERDbfile,REGISTERFileName,Size);
End;
If Not OK Then
REGISTERMsgStr := 'Database Could Not Be opened/Created';
End;
Procedure Open_Index;
Begin
Size := Sizeof(REGISTERDbrec.Datafld3) - 1;
REGISTERFilename := 'REGISTER.I3';
OpenIndex(REGISTERI3,REGISTERFileName,Size,Duplicates);
If Not OK Then
Begin
Size := Sizeof(REGISTERDbrec.Datafld3) - 1;
MakeIndex(REGISTERI3,REGISTERFileName,Size,Duplicates);
End;
If Not OK Then
REGISTERMsgStr := 'Index Could Not Be opened/Created';
Size := Sizeof(REGISTERDbrec.Datafld4) - 1;
REGISTERFilename := 'REGISTER.I4';
OpenIndex(REGISTERI4,REGISTERFileName,Size,Duplicates);
If Not OK Then
Begin
Size := Sizeof(REGISTERDbrec.Datafld4) - 1;
MakeIndex(REGISTERI4,REGISTERFileName,Size,Duplicates);
End;
If Not OK Then
REGISTERMsgStr := 'Index Could Not Be opened/Created';
End;
Procedure Close_Index;
Begin
CloseIndex(REGISTERI3);
CloseIndex(REGISTERI4);
End;
Procedure Close_File;
Begin
CloseFile(REGISTERDbfile);
End;
Procedure Load_Data;
Var Count, Result : word;
Begin
Close_Index;
Closefile(REGISTERDbfile);
Size := Sizeof(REGISTERDbrec);
Openfile(REGISTERDbfile,'REGISTER.dat',Size);
Assign(REGISTERLdFile,'REGISTER.Lod');
Size := Sizeof(REGISTERDbRec);
Reset(REGISTERLdFile,Size);
Size := Sizeof(REGISTERDbRec);
Count := 1;
Result := 1;
While Count = Result Do
Begin
BlockRead(REGISTERLdFile,REGISTERDbRec,Count,Result);
AddRec(REGISTERDbFile,RecordNumber,REGISTERDbRec);
If Not Ok Then
Begin
REGISTERMsgStr := 'Error Loading File';
Exit;
End;
If Count <> Result Then Exit;
End;
Close(REGISTERLdFile);
Open_Index;
For Fldseq := 1 to LastDataFld Do
Begin
ReBuild_index;
End;
End;
Procedure Dump_Data;
Var Count, Result : word;
Begin
Count := 1;
Close_Index;
Assign(REGISTERLdFile,'REGISTER.Lod');
Size := Sizeof(REGISTERDbRec);
ReWrite(REGISTERLdFile,Size);
Size := Sizeof(REGISTERDbRec);
For RecordNumber := 1 To Filelen(REGISTERDbFile) - 1 Do
Begin
GetRec(REGISTERDbFile,RecordNumber,REGISTERDbRec);
If Not Ok Then
Begin
REGISTERMsgStr := 'Error Dumping File';
Exit;
End;
BlockWrite(REGISTERLdFile,REGISTERDbRec,Count,Result);
End;
Close(REGISTERLdFile);
Open_Index;
End;
Procedure Build_Index;
Begin
Size := Maxkeylen;
End;
Procedure Utility;
Begin;
REGISTERMsgStr := ' F1-Rebuild Index F2-Load Data F3-Dump Data';
GotoXy(1,24);
Write(REGISTERMsgStr);
REGISTERMsgStr := 'Enter option and depress Enter key';
Gotoxy(1,25);
Write(REGISTERMsgStr);
Enterdata;
Case Function_Key Of
#59 : Rebuild_Index;
#60 : Load_Data;
#61 : Dump_Data;
Else
REGISTERMsgStr := ' Invalid Option';
End;
GotoXY(1,24);
For Xpos := 1 to 79 Do
Write(Scrnln[24,Xpos]);
End;
Procedure FunctionIO;
Begin
Case Function_Key OF
#13 : Function_Id := 'S';
#60, #81 : Function_Id := 'N';
#61, #73 : Function_Id := 'P';
#62 : Function_Id := 'F';
#63 : Function_Id := 'L';
#64 : Function_Id := 'A';
#65 : Function_Id := 'U';
#66 : Function_Id := 'D';
#68 : Begin
Utility;
Exit;
End;
End;
Case HldFldseq Of
3 : Begin
REGISTERCodeStr := REGISTERDbrec.Datafld3;
Case Function_Id Of
'S','A','U','D' : FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
'N' : NextKey(REGISTERI3,RecordNumber,REGISTERCodestr);
'P' : PrevKey(REGISTERI3,RecordNumber,REGISTERCodestr);
'F' : SearchKey(REGISTERI3,RecordNumber,REGISTERCodestr);
End;
End;
4 : Begin
REGISTERCodeStr := REGISTERDbrec.Datafld4;
Case Function_Id Of
'S','A','U','D' : FindKey(REGISTERI4,RecordNumber,REGISTERCodestr);
'N' : NextKey(REGISTERI4,RecordNumber,REGISTERCodestr);
'P' : PrevKey(REGISTERI4,RecordNumber,REGISTERCodestr);
'F' : SearchKey(REGISTERI4,RecordNumber,REGISTERCodestr);
End;
End;
Else
REGISTERCodeStr := REGISTERDbrec.Datafld3;
Case Function_Id Of
'S','A','U','D' : FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
'N' : NextKey(REGISTERI3,RecordNumber,REGISTERCodestr);
'P' : PrevKey(REGISTERI3,RecordNumber,REGISTERCodestr);
'F' : FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
End;
End;
Case Function_Id Of
'S' : Select_Rcd;
'N' : Next_Rcd;
'P' : Prev_Rcd;
'F' : Find_Rcd;
'L' : Begin
List_Rcd;
While (Ioresult <> 0) And (KeyChar <> #27) Do
List_Rcd;
End;
'A' : Insert_Rcd;
'U' : Update_Rcd;
'D' : Delete_Rcd;
'R' : Rebuild_Index;
End;
End;
Begin
ClearScrn := True;
Dups := False;
Size := Sizeof(REGISTERDbrec);
Open_DataBase;
Size := Sizeof(REGISTERCodestr) - 1;
Open_Index;
RecordNumber := 1;
REGISTER_Init;
{ Init_File; }
REGISTERMsgStr := ' ';
RecordNumber := 1;
RegisterCodeStr := '01';
RegisterCodeStr[0] := #2;
FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
If Ok Then
GetRec(RegisterDbFile,RecordNumber,RegisterDbRec);
Register_FmtScrnBUF;
While Continue Do
Begin
REGISTERDbRec.DataFld34 :=
'Depress F5 to Print when Filled out - ESC To Exit - F2 For Other titles';
GetDateTime;
REGISTERDbRec.Datafld1 := ScreenDate;
REGISTERDbRec.Datafld2 := ScreenTime;
REGISTER_FmtScrnBuf;
EnterData;
REGISTER_FmtRecBuf;
REGISTERMsgStr := ' ';
Gotoxy(1,REGISTERMsgln);
Write(' ');
{ USER CODE }
FunctionIo;
If Tchr1 = 'R' Then
Begin
RegisterCodeStr := '01';
RegisterCodeStr[0] := #2;
FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
RegisterTmDbRec.Datafld3 := 'RR';
RegisterDbRec.Datafld3 := 'RR';
Register_FmtScrnBuf;
If Ok Then
Begin
Update_rcd;
ClrScr;
Exit;
End;
End;
TextColor(Red);
Gotoxy(1,REGISTERMsgln);
Write(REGISTERMsgStr);
GotoXY(Mappos[Fldseq],Mapln[Fldseq]);
If Function_Key <> #27 Then Continue := True;
End;
TextColor(White);
Clrscr;
FlushRecord;
Close_Index;
Close_File;
RestoreCRTMode;
End;